perm filename BASIC.LSP[206,JMC]3 blob
sn#075776 filedate 1973-12-05 generic text, type T, neo UTF8
(DEFPROP BASICFNS
(BASICFNS ORLIS
ANDLIS
MAPCAR2
MAPCHOOSE
MAPAPP
PRUP
LISTSUBT
LISTSUBTA
CONTAINED
DELETE
PICKOUT
PICKOUTA)
VALUE)
(DEFPROP ORLIS
(LAMBDA(PRED U)
(AND (NOT (NULL U)) (OR (PRED (CAR U)) (ORLIS PRED (CDR U)))))
EXPR)
(DEFPROP ANDLIS
(LAMBDA(PRED U)
(OR (NULL U) (AND (PRED (CAR U)) (ANDLIS PRED (CDR U)))))
EXPR)
(DEFPROP MAPCAR2
(LAMBDA(FN U V)
(COND ((NULL U) NIL)
(T
(CONS (FN (CAR U) (CAR V)) (MAPCAR2 FN (CDR U) (CDR V))))))
EXPR)
(DEFPROP MAPCHOOSE
(LAMBDA(PRED FN U)
(COND ((NULL U) NIL)
((PRED (CAR U))
(CONS (FN (CAR U)) (MAPCHOOSE PRED FN (CDR U))))
(T (MAPCHOOSE PRED FN (CDR U)))))
EXPR)
(DEFPROP MAPAPP
(LAMBDA(FN U)
(COND ((NULL U) NIL)
(T (APPEND (FN (CAR U)) (MAPAPP FN (CDR U))))))
EXPR)
(DEFPROP PRUP
(LAMBDA(U V)
(COND ((NULL U)
(COND ((NULL V) NIL) (T (ERROR (QUOTE (V LONGER - PRUP))))))
((NULL V) (ERROR (QUOTE (U LONGER - PRUP))))
(T (CONS (CONS (CAR U) (CAR V)) (PRUP (CDR U) (CDR V))))))
EXPR)
(DEFPROP LISTSUBT
(LAMBDA (U V) (LISTSUBTA U (DIFFERENCE (LENGTH U) (LENGTH V)) NIL))
EXPR)
(DEFPROP LISTSUBTA
(LAMBDA(U N Z)
(COND ((EQUAL N 0) Z)
(T (LISTSUBTA (CDR U) (SUB1 N) (CONS (CAR U) Z)))))
EXPR)
(DEFPROP CONTAINED
(LAMBDA(U V)
(OR (NULL U) (AND (MEMBER (CAR U) V) (CONTAINED (CDR U) V))))
EXPR)
(DEFPROP DELETE
(LAMBDA(X U)
(COND ((NULL U) NIL)
((EQUAL X (CAR U)) (CDR U))
(T (CONS (CAR U) (DELETE X (CDR U))))))
EXPR)
(DEFPROP PICKOUT
(LAMBDA (PRED U) (PICKOUTA PRED U NIL NIL))
EXPR)
(DEFPROP PICKOUTA
(LAMBDA(PRED U X Y)
(COND ((NULL U) (CONS X Y))
((PRED (CAR U)) (PICKOUTA PRED (CDR U) (CONS (CAR U) X) Y))
(T (PICKOUTA PRED (CDR U) X (CONS (CAR U) Y)))))
EXPR)